Developer CD Series 2000 November: Tool Chest/Dev.CD Nov 00 TC Disk 1.toast/Sample Code/Archive/Networking/GetZoneList/GetZoneList.p

Text File | 2000-09-28 | 22.6 KB | 822 lines | [TEXT/MPS ]

{------------------------------------------------------------------------------
#
#    Apple Macintosh Developer Technical Support
#
#    AppleTalk GetZoneList Sample Application
#
#    GetZoneList
#
#    GetZoneList.p    -    Pascal Source
#
#    Copyright © 1988-90 Apple Computer, Inc.
#    All rights reserved.
#
#    Versions:    1.00                November 1988
#                1.01                October 1989
#                1.02                May 1990
#                1.03                June 1992
#                1.04                July 1992
#
#    Components:    GetZoneList.c        May 1, 1990
#                GetZoneList.p        May 1, 1990
#                GetZoneList.r        May 1, 1990
#                MakeFile            May 1, 1990
#                UFailure.a            November 1, 1988
#                UFailure.h            November 1, 1988
#                UFailure.inc1.p        November 1, 1988
#                UFailure.p            November 1, 1988
#
#    GetZoneList is a sample application that uses
#    AppleTalk ATP and ZIP to obtain a list of zones
#    on an AppleTalk internet.
#
#    GetZoneList also demonstrates using a signal, or
#    failure-catching mechanism to recover from error
#    situations.
#
#    GetZoneList is based on DTS Sample.p. For more
#    description and explanantion of the non-example
#    specific areas of this application, please refer to
#    either Sample.p or TESample.p.
#
------------------------------------------------------------------------------}

PROGRAM GetZoneList;

USES
    Types, QuickDraw, Events, Controls, Windows, TextEdit, Dialogs, Fonts, Lists,
    Menus, Resources, Scrap, ToolUtils,
    OSUtils, Files, Devices, DeskBus, DiskInit, Disks, Errors, Memory, Retrace, SegLoad, Serial,
    ShutDown, Slots, Sound, Start, Timer, AppleTalk, Packages, FixMath, Script, UFailure;

CONST
    _WaitNextEvent            = $A860;
    _Unimplemented            = $A89F;
    kSysEnvironsVersion        = 1;
    kOSEvent                = app4Evt;    {event used by MultiFinder}
    kSuspendResumeMessage    = 1;        {high byte of suspend/resume event message}
    kResumeMask                = 1;        {bit of message field for resume vs. suspend}

    kCR                = 13;                {carriage return character}
    kENTER            = 3;                {enter character}
    kScrollBarWidth    = 15;                {the width of the scrollbar in the list}
    kListInset        = -1;                {adjustment for list frame}
    kATPTimeOutVal    = 3;                {re-try ATP SendRequest every 3 seconds}
    kATPRetryCount    = 5;                {for five times}
    kZonesSize        = 578;                {size of buffer for zone names}
    kGZLCall        = $08000000;        {GetZoneList indicator}
    kZIPSocket        = 6;                {the Zone Information Protocol socket}
    kMoreZones        = $FF000000;        {mask to see if more zones to come}
    kZoneCount        = $0000FFFF;        {mask to count zones in buffer}
    kHilite            = 1;                {hilite value for button control}
    kDeHilite        = 0;                {dehilite value for button control}
    kHiliteDelay    = 8;                {time in ticks to leave button hilited}

    kMinHeap        = (29 * 1024);
    kMinSpace        = (20 * 1024);

    sErrStrings        = 128;                {error string STR#}
    eStandardErr    = 1;
    eWrongMachine    = 2;
    eSmallSize        = 3;
    eNoMemory        = 4;
    eAppleTalk        = 5;
    eNoZones        = 6;

    rAboutAlert        = 128;                {about alert}
    rZoneDialog        = 129;                {zone list dialog}
    dZoneList        = 2;                {user item that is zone list}
    dDefault        = 3;                {user item that is default indicator}
    rUserAlert        = 130;                {error alert}

    rMenuBar        = 128;                {application's menu bar}

    mApple            = 128;                {Apple menu}
    iAbout            = 1;

    mFile            = 129;                {File menu}
    iNew            = 1;
    iClose            = 4;
    iQuit            = 12;

    mEdit            = 130;                {Edit menu}
    iUndo            = 1;
    iCut            = 3;
    iCopy            = 4;
    iPaste            = 5;
    iClear            = 6;

    {1.01 - kDITop and kDILeft are used to locate the Disk Initialization dialogs.}
    kDITop        = $0050;
    kDILeft        = $0070;

VAR
    gMac                : SysEnvRec;    {set up by Initialize}
    gHasWaitNextEvent    : BOOLEAN;        {set up by Initialize}
    gInBackground        : BOOLEAN;        {maintained by Initialize and DoEvent}

    gList                : ListHandle;    {the list to be filled with zone names}



{$S Initialize}
FUNCTION TrapAvailable(tNumber: INTEGER; tType: TrapType): BOOLEAN;

{Check to see if a given trap is implemented. This is only used by the
 Initialize routine in this program, so we put it in the Initialize segment.
 The recommended approach to see if a trap is implemented is to see if
 the address of the trap routine is the same as the address of the
 Unimplemented trap.}
{1.02 - Needs to be called after call to SysEnvirons so that it can check
 if a ToolTrap is out of range of a pre-MacII ROM.}

BEGIN
    IF (tType = ToolTrap) &
        (gMac.machineType > envMachUnknown) &
        (gMac.machineType < envMacII) THEN BEGIN        {it's a 512KE, Plus, or SE}
        tNumber := BAND(tNumber, $03FF);
        IF tNumber > $01FF THEN                            {which means the tool traps}
            tNumber := _Unimplemented;                    {only go to $01FF}
    END;
    TrapAvailable := NGetTrapAddress(tNumber, tType) <>
                        NGetTrapAddress(_Unimplemented, ToolTrap);
END; {TrapAvailable}


{$S Main}
PROCEDURE FailOSErrMsg(result, message: INTEGER);
BEGIN
    IF result <> noErr THEN
        Failure(result, message);
END; {SignalOSErrMsg}


{$S Main}
PROCEDURE FailNILMsg(p: UNIV Ptr; message: INTEGER);
BEGIN
    IF p = NIL THEN
        Failure(memFullErr, message);
END; {FailNILMsg}


{$S Main}
PROCEDURE AlertUser(error: INTEGER; message: LongInt);

{Display an alert to inform the user of an error. Message acts as an
 index into a STR# resource of error messages. If no message is given,
 i.e. = 0, then use a standard message. If error is not noErr then
 display it as well.}

VAR
    msg1, msg2    : Str255;
    itemHit        : INTEGER;
BEGIN
    IF message <= 0 THEN message := eStandardErr;
    GetIndString(msg1, sErrStrings, message);
    IF error = noErr THEN
        msg2 := ''
    ELSE
        NumToString(error, msg2);
    ParamText(msg1, msg2, '', '');
    itemHit := Alert(rUserAlert, NIL);
END; {AlertUser}


{$S Main}
FUNCTION IsDAWindow(window: WindowPtr): BOOLEAN;
BEGIN
    IF window = NIL THEN
        IsDAWindow := FALSE
    ELSE    {DA windows have negative windowKinds}
        IsDAWindow := WindowPeek(window)^.windowKind < 0;
END; {IsDAWindow}


{$S Main}
FUNCTION IsAppWindow(window: WindowPtr): BOOLEAN;
BEGIN
    IF window = NIL THEN
        IsAppWindow := FALSE
    ELSE    {application windows have windowKinds >= userKind (8) or dialogKind (2)}
        WITH WindowPeek(window)^ DO
            IsAppWindow := (windowKind >= userKind) | (windowKind = dialogKind);
END; {IsAppWindow}


{$S Main}
PROCEDURE BuildZoneList;

{Create the list of zones on the network. Find a bridge to talk to , if one is
 present, then ask it for zone names. Add the names to the list in the dialog.}

VAR
    dATPPBptr                    : ATPPBptr;        {the parameter block for GetZoneList call}
    dBDS                        : BDSElement;    {the BDS for GetZoneList call}
    dZones, dCurr                : Ptr;            {the data buffer for GetZoneList call}
    dIndex, dCount, dNode, dNet    : INTEGER;
    ignore                        : INTEGER;
    cSize                        : Point;
    fi                            : FailInfo;
    nodeNetAddress, bridgeNode    : INTEGER;

    PROCEDURE CleanUp;
    BEGIN
        IF dATPPBptr <> NIL THEN
            DisposePtr(Ptr(dATPPBptr));                    {get rid of pb block}
        IF dZones <> NIL THEN
            DisposePtr(dZones);                            {and buffer}
    END; {CleanUp}

    PROCEDURE HandleErr(error: INTEGER; message: LongInt);
    BEGIN
        CleanUp;                                        {get rid of allocated junk}
    END;

BEGIN
    dATPPBptr := NIL;                                    {init some important variables}
    dZones := NIL;
    CatchFailures(fi, HandleErr);

    { get network address of node & node ID of bridge (if any) }
    FailOSErrMsg(GetNodeAddress(ignore, nodeNetAddress), eAppleTalk);
    bridgeNode := GetBridgeAddress;

    { test to see if bridge node fails.  If so, no internet. }
    if (bridgeNode = 0) then
        Failure(0, eNoZones);                                    { bail if no zones present }

    dATPPBptr := ATPPBptr(NewPtr(SIZEOF(ATPParamBlock)));
    FailNILMsg(dATPPBptr, eNoMemory);
    dZones := NewPtr(kZonesSize);
    FailNILMsg(dZones, eNoMemory);
    WITH dBDS DO BEGIN                                    {set up BDS}
        buffSize := kZonesSize;
        buffPtr := dZones;
        END;
    WITH dATPPBptr^ DO BEGIN                            {set up pb block}
        atpFlags := 0;

        addrBlock.aNet := nodeNetAddress;
        addrBlock.aNode := bridgeNode;                    {get node of bridge}
        addrBlock.aSocket := kZIPSocket;                {the socket we want}
        reqLength := 0;
        reqPointer := NIL;
        bdsPointer := @dBDS;
        numOfBuffs := 1;
        timeOutVal := kATPTimeOutVal;
        retryCount := kATPRetryCount;
        END;
    dIndex := 1;
    dCount := 0;
    SetPt(cSize, 0, 0);                                    {we always stuff into first}
    REPEAT
        dATPPBptr^.userData := kGZLCall + dIndex;        {indicate GetZoneList request}
        FailOSErrMsg(PSendRequest(dATPPBptr,
            FALSE), eAppleTalk);                        {send sync request}
        dCount := dCount + BAND(dBDS.userBytes,
                    kZoneCount);                        {find out how many returned}
        dCurr := dZones;                                {put current pointer at start}
        REPEAT                                            {get each zone}
            ignore := LAddRow(1, 0, gList);                {create new cell at start}
            LSetCell(POINTER(ORD4(dCurr) + 1), dCurr^,
                        cSize, gList);                    {stuff in zone}
            dCurr := POINTER(ORD4(dCurr) + dCurr^+1);    {bump up current pointer}
            dIndex := dIndex + 1;                        {increment which zone}
        UNTIL dIndex > dCount;
    UNTIL (BAND(dBDS.userBytes, kMoreZones) <> 0);        {keep going until none left}
    CleanUp;

    Success(fi);
END; {BuildZoneList}


{$S Main}
PROCEDURE BuildZoneListPhase2;

{Create the list of zones on the network. Find a bridge to talk to , if one is
 present, then ask it for zone names. Add the names to the list in the dialog.}

VAR
    dXPBPBPtr                    : xPPParmBlkPtr;
    dBDS                        : BDSElement;    {the BDS for GetZoneList call}
    dZones, dCurr                : Ptr;            {the data buffer for GetZoneList call}
    dIndex, dCount, dNode, dNet    : INTEGER;
    ignore                        : INTEGER;
    cSize                        : Point;
    fi                            : FailInfo;
    xppDriverRefNum                : INTEGER;

    PROCEDURE CleanUp;
    BEGIN
        IF dXPBPBPtr <> NIL THEN
            DisposePtr(Ptr(dXPBPBPtr));                    {get rid of pb block}
        IF dZones <> NIL THEN
            DisposePtr(dZones);                            {and buffer}
    END; {CleanUp}

    PROCEDURE HandleErr(error: INTEGER; message: LongInt);
    BEGIN
        CleanUp;                                        {get rid of allocated junk}
    END;

BEGIN
    dXPBPBPtr := NIL;                                    {init some important variables}
    dZones := NIL;
    CatchFailures(fi, HandleErr);

    { Get network address of bridge.  If zero, no internet. }
    if (GetBridgeAddress = 0) then
        Failure(0, eNoZones);                                    { bail if no zones present }

    { get a hold of the XPP driver reference number-this is the safest way }
    FailOSErrMsg(OpenDriver('.XPP', xppDriverRefNum), eAppleTalk);

    dXPBPBPtr := xPPParmBlkPtr(NewPtr(SIZEOF(xPPParamBlock)));
    FailNILMsg(dXPBPBPtr, eNoMemory);
    dZones := NewPtr(kZonesSize);
    FailNILMsg(dZones, eNoMemory);

    dXPBPBPtr^.zipInfoField[1] := 0;    { ALWAYS 0 on first call.  has state info on subsequent calls }
    dXPBPBPtr^.zipInfoField[2] := 0;    { ALWAYS 0 on first call.  has state info on subsequent calls }
    dXPBPBPtr^.zipLastFlag := 0;

    dXPBPBPtr^.ioRefNum := xppDriverRefNum;
    dXPBPBPtr^.csCode := xCall;
    dXPBPBPtr^.xppSubCode := zipGetZoneList;
    dXPBPBPtr^.xppTimeOut := kATPTimeOutVal;
    dXPBPBPtr^.xppRetry := kATPRetryCount;
    dXPBPBPtr^.zipBuffPtr := Ptr( dZones);

    dIndex := 1;
    dCount := 0;
    SetPt(cSize, 0, 0);                                    {we always stuff into first}
    REPEAT
        FailOSErrMsg(PBControl(ParmBlkPtr (dXPBPBPtr), false), eAppleTalk);        { send sync control call }
        dCount := dCount + dXPBPBPtr^.zipNumZones;                        { find out how many returned }

        dCurr := dZones;                                {put current pointer at start}
        REPEAT                                            {get each zone}
            ignore := LAddRow(1, 0, gList);                {create new cell at start}
            LSetCell(POINTER(ORD4(dCurr) + 1), dCurr^,
                cSize, gList);                            {stuff in zone}
            dCurr := POINTER(ORD4(dCurr) + dCurr^+1);    {bump up current pointer}
            dIndex := dIndex + 1;                        {increment which zone}
        UNTIL dIndex > dCount;
    UNTIL (dXPBPBPtr^.zipLastFlag <> 0);        {keep going until none left}
    CleanUp;

    Success(fi);
END; {BuildZoneListPhase2}


{$S Main}
PROCEDURE ZoneListDraw(dlg: DialogPtr; item: INTEGER);

{The user item procedure for the zone list user item and default
 box user item in the dialog. Draw the list and the frame that goes with it.
 Draw the default box around the OK button.}

VAR
    port    : GrafPtr;
    kind    : INTEGER;
    h        : Handle;
    r        : Rect;
    ps        : PenState;

BEGIN
    GetPort(port);                                    {save old port}
    SetPort(dlg);                                    {make dialog port}
    CASE item OF
    dZoneList: BEGIN
            LUpdate(dlg^.visRgn, gList);            {re-draw list}
            GetDialogItem(dlg, dZoneList, kind, h, r);
            InsetRect(r, kListInset, kListInset);
            FrameRect(r);                            {re-draw frame}
        END;
    dDefault: BEGIN
            GetDialogItem(dlg, dDefault, kind, h, r);
            GetPenState(ps);
            PenNormal;                                {always be on the defensive}
            PenSize(3, 3);
            InsetRect(r, -4, -4);
            FrameRoundRect(r, 16, 16);                {draw default box}
            SetPenState(ps);
        END;
    END;
    SetPort(port);                                    {restore old port}
END; {ZoneListDraw}


{$S Main}
FUNCTION ListFilter (dlg: DialogPtr; VAR event: EventRecord;
                                            VAR item: INTEGER) : BOOLEAN;

{Passed as parameter to ModalDialog. Handle key presses and mouse clicks
 from the user. Do all the right default actions since we override them
 by virtue of our existence.}

VAR
    port        : GrafPtr;
    loc            : Point;
    kind        : INTEGER;
    h            : Handle;
    r            : Rect;
    ignore        : BOOLEAN;
    key            : SignedByte;
    finalTicks    : LongInt;
BEGIN
    ListFilter := FALSE;                                {always default FALSE}
    CASE event.what OF
        keyDown, autoKey: BEGIN                            {check for <cr> or <enter>}
            key := SignedByte(event.message);
            IF key IN [kCR, kENTER] THEN BEGIN            {it was a <cr> or <enter>}
                GetDialogItem(dlg, ok, kind, h, r);
                HiliteControl(ControlHandle(h), kHilite);
                Delay(kHiliteDelay, finalTicks);
                HiliteControl(ControlHandle(h), kDeHilite);
                ListFilter := TRUE;                        {so we handle it}
                item := 1;                                {and make the first item hit}
            END;
        END;
        mouseDown: BEGIN                                {we want mouseDowns}
            GetPort(port);
            SetPort(dlg);
            loc := event.where;
            GlobalToLocal(loc);                            {find where clicked}
            GetDialogItem(dlg, dZoneList, kind, h, r);        {get rect for list}
            IF PtInRect(loc, r) THEN BEGIN                {if clicked inside…}
                ListFilter := TRUE;                        {we take care of it}
                ignore := LClick(loc, event.modifiers,
                                    gList);                {by passing click to list}
            END;
            SetPort(port);
        END;
    END;
END; {ListFilter}


{$S Main}
PROCEDURE DoZoneList;

{Put up a modal dialog that shows a list of the zones on the net. Create the dialog
 and list, call BuildZoneList to fill it, then wait for the user to click OK.}

VAR
    dlg                        : DialogPtr;
    item, kind                : INTEGER;
    h                        : Handle;
    r, rView, dataBounds    : Rect;
    cSize                    : Point;
    fi                        : FailInfo;
    hor, ver                : INTEGER;
    mfUPP                    : ModalFilterUPP;

    PROCEDURE CleanUp;
    BEGIN
        IF gList <> NIL THEN
            LDispose(gList);                                {get rid of list}
        IF dlg <> NIL THEN
            DisposeDialog(dlg);                                {get rid of dialog}
    END; {CleanUp}

    PROCEDURE HandleErr(error: INTEGER; message: LongInt);
    BEGIN
        CleanUp;                                            {release junk}
    END;

BEGIN
    gList := NIL;                                            {init some important variables}
    dlg := NIL;
    CatchFailures(fi, HandleErr);

    dlg := GetNewDialog(rZoneDialog, NIL, POINTER(-1));        {create dialog}
    FailNILMsg(dlg, eNoMemory);

    {We center the dialog horizontally and position it vertically one-third the
     distance from the menu bar to the bottom of the main device. We do not
     check for the dialog extending past the bottom of the device because we
     know the dialog is not that big. You may wish to make that check.}
    WITH dlg^.portRect DO BEGIN
        hor := right - left;
        ver := bottom - top;
    END;
    WITH qd.screenBits.bounds DO BEGIN
        hor := ((right - left) - hor) DIV 2;
        ver := (((bottom - top) - ver - GetMBarHeight) DIV 3) + GetMBarHeight;
    END;
    MoveWindow(dlg, hor, ver, FALSE);

    GetDialogItem(dlg, dDefault, kind, h, r);
    h := @ZoneListDraw;                                        {connect drawing procedure}
    SetDialogItem(dlg, dDefault, kind, h, r);
    GetDialogItem(dlg, dZoneList, kind, h, r);
    h := @ZoneListDraw;                                        {connect drawing procedure}
    SetDialogItem(dlg, dZoneList, kind, h, r);
    rView := r;
    WITH rView DO
        right := right - kScrollBarWidth;                    {adjust rectangle for scroll}
    SetRect(dataBounds, 0, 0, 1, 0);                        {init to one-wide list}
    SetPt(cSize, 0, 0);
    gList := LNew(rView, dataBounds, cSize, 0, WindowPtr(dlg),
                    FALSE, FALSE, FALSE, TRUE);                {create with vertical scroll}
    FailNILMsg(gList, eNoMemory);

    if gMac.atDrvrVersNum >= 53 then
        BuildZoneListPhase2
    else
        BuildZoneList;                                        {put the stuff into the list}

    SetPt(cSize, 0, 0);
    LSetSelect(TRUE, cSize, gList);                            {select the first guy}
    LSetDrawingMode(TRUE, gList);                            {turn on the list}
    ShowWindow(dlg);                                        {turn on the dialog}
    mfUPP := NewModalFilterProc(@ListFilter);
    REPEAT
        ModalDialog(mfUPP, item);                            {accept events}
    UNTIL item = ok;                                        {until he presses 'ok'}
    DisposeRoutineDescriptor(mfUPP);
    CleanUp;

    Success(fi);
END; {DoZoneList}


{$S Main}
FUNCTION DoCloseWindow(window: WindowPtr) : BOOLEAN;
BEGIN
    DoCloseWindow := TRUE;
    IF IsDAWindow(window) THEN
        CloseDeskAcc(WindowPeek(window)^.windowKind);
    IF IsAppWindow(window) THEN
        CloseWindow(window);
END; {DoCloseWindow}


{$S Initialize}
PROCEDURE Initialize;
VAR
    menuBar            : Handle;
    window            : WindowPtr;
    ignoreError        : OSErr;
    total, contig    : LongInt;
    ignoreResult    : BOOLEAN;
    event            : EventRecord;
    count            : INTEGER;
    fi                : FailInfo;

    PROCEDURE HandleErr(error: INTEGER; message: LongInt);
    BEGIN
        IF error > 0 THEN
            AlertUser(0, error)
        ELSE
            AlertUser(error, message);
        ExitToShell;
    END; {HandleErr}

BEGIN
    gHasWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
    gInBackground := FALSE;

    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;

    FOR count := 1 TO 3 DO
        ignoreResult := EventAvail(everyEvent, event);

    CatchFailures(fi, HandleErr);

    FailOSErrMsg(MPPOpen, eAppleTalk);
    FailOSErrMsg(ATPLoad, eAppleTalk);

    ignoreError := SysEnvirons(kSysEnvironsVersion, gMac);
    IF gMac.machineType < 0 THEN
        Failure(0, eWrongMachine);

    IF ORD(GetApplLimit) - ORD(ApplicationZone) < kMinHeap THEN
        Failure(0, eSmallSize);

    PurgeSpace(total, contig);
    IF total < kMinSpace THEN
        Failure(0, eNoMemory);

    menuBar := GetNewMBar(rMenuBar);        {read menus into menu bar}
    FailNILMsg(menuBar, eNoMemory);
    SetMenuBar(menuBar);                    {install menus}
    DisposeHandle(menuBar);
    AppendResMenu(GetMenuHandle(mApple), 'DRVR');    {add DA names to Apple menu}
    DrawMenuBar;

    Success(fi);
END; {Initialize}


{$S Main}
PROCEDURE Terminate;
VAR
    aWindow    : WindowPtr;
    closed    : BOOLEAN;

BEGIN
    closed := TRUE;
    REPEAT
        aWindow := FrontWindow;                    {get the current front window}
        IF aWindow <> NIL THEN
            closed := DoCloseWindow(aWindow);    {close this window}
    UNTIL (NOT closed) | (aWindow = NIL);        {do all windows}
    IF closed THEN
        ExitToShell;                            {exit if no cancellation}
END; {Terminate}


{$S Main}
PROCEDURE AdjustMenus;
VAR
    window            : WindowPtr;
    menu            : MenuHandle;

BEGIN
    window := FrontWindow;

    menu := GetMenuHandle(mFile);
    IF IsDAWindow(window) THEN                {we can allow desk accessories to be closed from the menu}
        EnableItem(menu, iClose)
    ELSE
        DisableItem(menu, iClose);            {but not our traffic light window}

    menu := GetMenuHandle(mEdit);
    IF IsDAWindow(window) THEN BEGIN        {a desk accessory might need the edit menu}
        EnableItem(menu, iUndo);
        EnableItem(menu, iCut);
        EnableItem(menu, iCopy);
        EnableItem(menu, iPaste);
        EnableItem(menu, iClear);
    END ELSE BEGIN                            {but we know we do not}
        DisableItem(menu, iUndo);
        DisableItem(menu, iCut);
        DisableItem(menu, iCopy);
        DisableItem(menu, iClear);
        DisableItem(menu, iPaste);
    END;

END; {AdjustMenus}


{$S Main}
PROCEDURE DoMenuCommand(menuResult: LONGINT);
VAR
    menuID            : INTEGER;        {the resource ID of the selected menu}
    menuItem        : INTEGER;        {the item number of the selected menu}
    itemHit            : INTEGER;
    daName            : Str255;
    daRefNum        : INTEGER;
    handledByDA        : BOOLEAN;
    ignore            : BOOLEAN;
    fi                : FailInfo;

    PROCEDURE HandleMenu(error: INTEGER; message: LongInt);
    BEGIN
        HiliteMenu(0);                {unhighlight what MenuSelect (or MenuKey) hilited}
    END;

BEGIN
    CatchFailures(fi, HandleMenu);
    menuID := HiWord(menuResult);    {use built-ins (for efficiency)...}
    menuItem := LoWord(menuResult);    {to get menu item number and menu number}
    CASE menuID OF
        mApple:
            CASE menuItem OF
                iAbout:                {bring up alert for About}
                    itemHit := Alert(rAboutAlert, NIL);
                OTHERWISE BEGIN        {all non-About items in this menu are DAs}
                    GetMenuItemText(GetMenuHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
            END;
        mFile:
            CASE menuItem OF
                iNew:
                    DoZoneList;
                iClose:
                    ignore := DoCloseWindow(FrontWindow);
                iQuit:
                    Terminate;
            END;
        mEdit:                        {call SystemEdit for DA editing & MultiFinder}
            handledByDA := SystemEdit(menuItem-1);    {since we don't do any editing}
    END;
    Success(fi);
    HiliteMenu(0);                    {cleanup}
END; {DoMenuCommand}


{$S Main}
PROCEDURE DoEvent(event: EventRecord);
VAR
    part, err    : INTEGER;
    window        : WindowPtr;
    hit            : BOOLEAN;
    key            : CHAR;
    fi            : FailInfo;
    aPoint        : Point;

    PROCEDURE HandleErr(error: INTEGER; message: LongInt);
    BEGIN
        IF error > 0 THEN
            AlertUser(0, error)
        ELSE
            AlertUser(error, message);
        EXIT(DoEvent);
    END; {HandleErr}

BEGIN
    CatchFailures(fi, HandleErr);

    CASE event.what OF
        mouseDown: BEGIN
            part := FindWindow(event.where, window);
            CASE part OF
                inMenuBar: BEGIN            {process the menu command}
                    AdjustMenus;
                    DoMenuCommand(MenuSelect(event.where));
                END;
                inSysWindow:                {let the system handle the mouseDown}
                    SystemClick(event, window);
                inContent:;
                inDrag:;
                inGrow:;
                inZoomIn, inZoomOut:;
            END;
        END;
        keyDown, autoKey: BEGIN                {check for menukey equivalents}
            key := CHR(BAnd(event.message, charCodeMask));
            IF BAnd(event.modifiers, cmdKey) <> 0 THEN    {Command key down}
                IF event.what = keyDown THEN BEGIN
                    AdjustMenus;            {enable/disable/check menu items properly}
                    DoMenuCommand(MenuKey(key));
                END;
        END;                                {call DoActivate with the window and...}
        activateEvt:;
        updateEvt:;
        {1.01 - It is not a bad idea to at least call DIBadMount in response
         to a diskEvt, so that the user can format a floppy.}
        diskEvt:
            IF HiWord(event.message) <> noErr THEN BEGIN
                SetPt(aPoint, kDILeft, kDITop);
                err := DIBadMount(aPoint, event.message);
            END;
        kOSEvent:
            CASE BAnd(BRotL(event.message, 8), 255) OF    {high byte of message}
                kSuspendResumeMessage: BEGIN
                    gInBackground := BAnd(event.message, kResumeMask) = 0;
                END;
            END;
    END;

    Success(fi);
END; {DoEvent}


{$S Main}
PROCEDURE EventLoop;
VAR
    cursorRgn    : RgnHandle;
    gotEvent    : BOOLEAN;
    event        : EventRecord;

BEGIN
    cursorRgn := NewRgn;            {we’ll pass WNE an empty region the 1st time thru}

    REPEAT
        IF gHasWaitNextEvent THEN    {put us 'asleep' forever under MultiFinder}
            gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn)
        ELSE BEGIN
            SystemTask;                {must be called if using GetNextEvent}
            gotEvent := GetNextEvent(everyEvent, event);
        END;
        IF gotEvent THEN BEGIN
            DoEvent(event);
        END;
    UNTIL FALSE;                    {loop forever; we quit through an ExitToShell}
END; {EventLoop}


PROCEDURE _DataInit; EXTERNAL;


{$S Main}
BEGIN
    UnloadSeg(@_DataInit);        {note that _DataInit must not be in Main!}
    MaxApplZone;                {expand the heap so code segments load at the top}

    InitSignals;
    Initialize;                    {initialize the program}
    UnloadSeg(@Initialize);        {note that Initialize must not be in Main!}

    EventLoop;                    {call the main event loop}
END.